Avg number of beds each season

library(tidyverse)
library(lubridate)
library(ggplot2)

beds <- read_csv(here::here("raw_data/beds_by_nhs_board_of_treatment_and_specialty.csv")) %>% 
        janitor::clean_names()
Rows: 30448 Columns: 20
-- Column specification ----------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (11): Quarter, QuarterQF, HB, HBQF, Location, LocationQF, Specialty, SpecialtyQF, SpecialtyName, SpecialtyNameQF, PercentageOccupancyQF
dbl  (5): AllStaffedBeds, TotalOccupiedBeds, AverageAvailableStaffedBeds, AverageOccupiedBeds, PercentageOccupancy
lgl  (4): AllStaffedBedsQF, TotalOccupiedBedsQF, AverageAvailableStaffedBedsQF, AverageOccupiedBedsQF

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(beds)

# interested in percentage of available beds
# data is structured to show avg daily percentage of available beds per hospital (id = "hb")
# comparing against the time of year "quarter"

Cleaning

# checking column is clean
beds %>% 
  count(quarter)

beds_season <- beds %>% 
  mutate(
    season = str_extract(quarter, "\\d{1}$"),
    season = recode(season, 
      "1" = "Winter",
      "2" = "Spring",
      "3" = "Summer",
      "4" = "Autumn"
    ),
    year = as.numeric(str_extract(quarter, "^\\d{4}"))
  )

Making Graph

beds_season %>% 
  group_by(season) %>% 
  summarise(avg_daily_beds_perc = mean(percentage_occupancy, na.rm = TRUE)) %>% 
  ggplot() +
  aes(x = season, y = avg_daily_beds_perc, label = str_c(round(avg_daily_beds_perc), "%")) +
  geom_text(nudge_y = 1, alpha = 0.8) +
  geom_col(fill = "turquoise", alpha = 0.8) +
  coord_cartesian(ylim = c(60, 80)) +
  theme_minimal()


beds_season %>% 
  group_by(season, year) %>% 
  summarise(avg_daily_beds_perc = mean(percentage_occupancy, na.rm = TRUE)) %>% 
  ggplot() +
  aes(x = season, y = avg_daily_beds_perc, label = str_c(round(avg_daily_beds_perc), "%")) +
  geom_text(nudge_y = 1.2, alpha = 0.8) +
  geom_col(fill = "turquoise", alpha = 0.8) +
  coord_cartesian(ylim = c(60, 80)) +
  facet_wrap(~year) +
  theme_minimal()
`summarise()` has grouped output by 'season'. You can override using the `.groups` argument.

Avg number of admissions each season (can be split by simd rating)

admissions <- read_csv(here::here("raw_data/hospital_admissions_hb_simd_20220302.csv")) %>% 
        janitor::clean_names()
Rows: 21138 Columns: 9
-- Column specification ----------------------------------------------------------------------------------------------------------------------
Delimiter: ","
chr (4): HB, HBQF, AdmissionType, AdmissionTypeQF
dbl (5): WeekEnding, SIMDQuintile, NumberAdmissions, Average20182019, PercentVariation

i Use `spec()` to retrieve the full column specification for this data.
i Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(admissions)

Cleaning

admissions_date <- admissions %>% 
  mutate(
    year = str_extract(week_ending, "^\\d{4}"),
    monthday = str_extract(week_ending, "\\d{4}$"),
    month = str_extract(monthday, "^\\d{2}"),
    day = str_extract(monthday, "\\d{2}$"),
    date = ymd(str_c(year, month, day)),
    .before = 1
  ) %>% 
  select(-monthday)

head(admissions_date)
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQojIEF2ZyBudW1iZXIgb2YgYmVkcyBlYWNoIHNlYXNvbg0KDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShsdWJyaWRhdGUpDQpsaWJyYXJ5KGdncGxvdDIpDQoNCmJlZHMgPC0gcmVhZF9jc3YoaGVyZTo6aGVyZSgicmF3X2RhdGEvYmVkc19ieV9uaHNfYm9hcmRfb2ZfdHJlYXRtZW50X2FuZF9zcGVjaWFsdHkuY3N2IikpICU+JSANCiAgICAgICAgamFuaXRvcjo6Y2xlYW5fbmFtZXMoKQ0KDQpoZWFkKGJlZHMpDQoNCiMgaW50ZXJlc3RlZCBpbiBwZXJjZW50YWdlIG9mIGF2YWlsYWJsZSBiZWRzDQojIGRhdGEgaXMgc3RydWN0dXJlZCB0byBzaG93IGF2ZyBkYWlseSBwZXJjZW50YWdlIG9mIGF2YWlsYWJsZSBiZWRzIHBlciBob3NwaXRhbCAoaWQgPSAiaGIiKQ0KIyBjb21wYXJpbmcgYWdhaW5zdCB0aGUgdGltZSBvZiB5ZWFyICJxdWFydGVyIg0KYGBgDQojIyBDbGVhbmluZw0KDQpgYGB7cn0NCiMgY2hlY2tpbmcgY29sdW1uIGlzIGNsZWFuDQpiZWRzICU+JSANCiAgY291bnQocXVhcnRlcikNCg0KYmVkc19zZWFzb24gPC0gYmVkcyAlPiUgDQogIG11dGF0ZSgNCiAgICBzZWFzb24gPSBzdHJfZXh0cmFjdChxdWFydGVyLCAiXFxkezF9JCIpLA0KICAgIHNlYXNvbiA9IHJlY29kZShzZWFzb24sIA0KICAgICAgIjEiID0gIldpbnRlciIsDQogICAgICAiMiIgPSAiU3ByaW5nIiwNCiAgICAgICIzIiA9ICJTdW1tZXIiLA0KICAgICAgIjQiID0gIkF1dHVtbiINCiAgICApLA0KICAgIHllYXIgPSBhcy5udW1lcmljKHN0cl9leHRyYWN0KHF1YXJ0ZXIsICJeXFxkezR9IikpDQogICkNCmBgYA0KIyMgTWFraW5nIEdyYXBoDQoNCmBgYHtyfQ0KYmVkc19zZWFzb24gJT4lIA0KICBncm91cF9ieShzZWFzb24pICU+JSANCiAgc3VtbWFyaXNlKGF2Z19kYWlseV9iZWRzX3BlcmMgPSBtZWFuKHBlcmNlbnRhZ2Vfb2NjdXBhbmN5LCBuYS5ybSA9IFRSVUUpKSAlPiUgDQogIGdncGxvdCgpICsNCiAgYWVzKHggPSBzZWFzb24sIHkgPSBhdmdfZGFpbHlfYmVkc19wZXJjLCBsYWJlbCA9IHN0cl9jKHJvdW5kKGF2Z19kYWlseV9iZWRzX3BlcmMpLCAiJSIpKSArDQogIGdlb21fdGV4dChudWRnZV95ID0gMSwgYWxwaGEgPSAwLjgpICsNCiAgZ2VvbV9jb2woZmlsbCA9ICJ0dXJxdW9pc2UiLCBhbHBoYSA9IDAuOCkgKw0KICBjb29yZF9jYXJ0ZXNpYW4oeWxpbSA9IGMoNjAsIDgwKSkgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KYmVkc19zZWFzb24gJT4lIA0KICBncm91cF9ieShzZWFzb24sIHllYXIpICU+JSANCiAgc3VtbWFyaXNlKGF2Z19kYWlseV9iZWRzX3BlcmMgPSBtZWFuKHBlcmNlbnRhZ2Vfb2NjdXBhbmN5LCBuYS5ybSA9IFRSVUUpKSAlPiUgDQogIGdncGxvdCgpICsNCiAgYWVzKHggPSBzZWFzb24sIHkgPSBhdmdfZGFpbHlfYmVkc19wZXJjLCBsYWJlbCA9IHN0cl9jKHJvdW5kKGF2Z19kYWlseV9iZWRzX3BlcmMpLCAiJSIpKSArDQogIGdlb21fdGV4dChudWRnZV95ID0gMS4yLCBhbHBoYSA9IDAuOCkgKw0KICBnZW9tX2NvbChmaWxsID0gInR1cnF1b2lzZSIsIGFscGhhID0gMC44KSArDQogIGNvb3JkX2NhcnRlc2lhbih5bGltID0gYyg2MCwgODApKSArDQogIGZhY2V0X3dyYXAofnllYXIpICsNCiAgdGhlbWVfbWluaW1hbCgpDQpgYGANCg0KIyBBdmcgbnVtYmVyIG9mIGFkbWlzc2lvbnMgZWFjaCBzZWFzb24gKGNhbiBiZSBzcGxpdCBieSBzaW1kIHJhdGluZykNCg0KYGBge3J9DQphZG1pc3Npb25zIDwtIHJlYWRfY3N2KGhlcmU6OmhlcmUoInJhd19kYXRhL2hvc3BpdGFsX2FkbWlzc2lvbnNfaGJfc2ltZF8yMDIyMDMwMi5jc3YiKSkgJT4lIA0KICAgICAgICBqYW5pdG9yOjpjbGVhbl9uYW1lcygpDQoNCmhlYWQoYWRtaXNzaW9ucykNCmBgYA0KDQojIyBDbGVhbmluZw0KDQpgYGB7cn0NCmFkbWlzc2lvbnNfZGF0ZSA8LSBhZG1pc3Npb25zICU+JSANCiAgbXV0YXRlKA0KICAgIHllYXIgPSBzdHJfZXh0cmFjdCh3ZWVrX2VuZGluZywgIl5cXGR7NH0iKSwNCiAgICBtb250aGRheSA9IHN0cl9leHRyYWN0KHdlZWtfZW5kaW5nLCAiXFxkezR9JCIpLA0KICAgIG1vbnRoID0gc3RyX2V4dHJhY3QobW9udGhkYXksICJeXFxkezJ9IiksDQogICAgZGF5ID0gc3RyX2V4dHJhY3QobW9udGhkYXksICJcXGR7Mn0kIiksDQogICAgZGF0ZSA9IHltZChzdHJfYyh5ZWFyLCBtb250aCwgZGF5KSksDQogICAgLmJlZm9yZSA9IDENCiAgKSAlPiUgDQogIHNlbGVjdCgtbW9udGhkYXkpDQoNCmhlYWQoYWRtaXNzaW9uc19kYXRlKQ0KYGBgDQoNCmBgYHtyfQ0KbGlicmFyeSh0c2liYmxlKQ0KDQpkdXBsaWNhdGVzKGFkbWlzc2lvbnNfZGF0ZSkNCg0KIyBtYWtpbmcgZGF0ZXRpbWUgdHNpYmJsZQ0KDQphZG1pc3Npb25zX2R0IDwtIGFkbWlzc2lvbnNfZGF0ZSAlPiUgDQogIGdyb3VwX2J5KGRhdGUpICU+JSANCiAgc3VtbWFyaXNlKGF2Z19hZG1pc3Npb25zX2J5X3dlZWsgPSBtZWFuKG51bWJlcl9hZG1pc3Npb25zKSkgJT4lIA0KICBhc190c2liYmxlKCkNCg0KY2xhc3MoYWRtaXNzaW9uc19kdCRkYXRlKQ0KDQphZG1pc3Npb25zX3Bsb3RseSA8LSBhZG1pc3Npb25zX2R0ICU+JQ0KICBnZ3Bsb3QoKSArDQogIGFlcyh4ID0gZGF0ZSwgeSA9IGF2Z19hZG1pc3Npb25zX2J5X3dlZWspICsNCiAgZ2VvbV9saW5lKGNvbG9yID0gInN0ZWVsYmx1ZSIpICsNCiAgc2NhbGVfeF9kYXRlKG5hbWUgPSAiIiwgbGltaXRzID0gYyhhcy5EYXRlKCIyMDIwLTAxLTAxIiwgIiVZLSVtLSVkIiksIGFzLkRhdGUoIjIwMjItMDItMjAiLCAiJVktJW0tJWQiKSksIGRhdGVfYnJlYWtzID0gIjMgbW9udGhzIiwgDQogICAgICAgICAgICAgICBkYXRlX21pbm9yX2JyZWFrcyA9ICIxIG1vbnRoIikgKw0KICB0aGVtZV9taW5pbWFsKCkNCg0KZ2dwbG90bHkoYWRtaXNzaW9uc19wbG90bHkpDQpgYGANCg0KYGBge3J9DQoNCmBgYA0KDQo=